home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / ps.tcl.z / ps.tcl
Text File  |  2002-07-08  |  3KB  |  125 lines
  1. # ps.tcl
  2. #
  3. #    Code to look for processes in the process table.
  4. # Copyright 1995 Xerox Corporation All rights reserved.
  5. #License is granted to copy, to use, and to make and to use derivative works for
  6. # research and evaluation purposes, provided that the Xerox copyright notice and
  7. # this license notice is included in all copies and any derivatives works and in
  8. # all  related documentation.  Xerox grants no other licenses expressed or
  9. # implied and the licensee acknowleges that Xerox has no  liability for
  10. # licensee's use or for any derivative works  made by licensee. The Xerox  name
  11. # shall not be used in any advertising or the like without its written
  12. # permission.
  13. # This software is provided AS IS.  XEROX CORPORATION DISCLAIMS AND LICENSEE
  14. # AGREES THAT ALL WARRANTIES, EXPRESS OR IMPLIED, INCLUDING WITHOUT LIMITATION
  15. #THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
  16. #NOTWITHSTANDING ANY OTHER PROVISION CONTAINED HEREIN, ANY LIABILITY FOR DAMAGES
  17. # RESULTING FROM THE SOFTWARE OR ITS USE IS EXPRESSLY DISCLAIMED, INCLUDING
  18. # CONSEQUENTIAL OR ANY OTHER INDIRECT DAMAGES, WHETHER ARISING IN CONTRACT, TORT
  19. # (INCLUDING NEGLIGENCE) OR STRICT LIABILITY, EVEN IF XEROX CORPORATION IS
  20. # ADVISED OF THE POSSIBILITY OF SUCH DAMAGES."
  21. #
  22.  
  23. if [catch {exec uname -s} os] {
  24.     set os nextstep    ;# No uname there
  25.     set name noname
  26. } else {
  27.     if [catch {exec uname -n} name] {
  28.     set name $os
  29.     }
  30. }
  31. if {[string compare $name $os] == 0} {
  32.     # Bogus OS name on many SYS V systems
  33.     set os unix_sv
  34. }
  35. if {[info exist env(LOGNAME)]} {
  36.     # Sys V has LOGNAME instead of USER
  37.     set env(USER) $env(LOGNAME)
  38. }
  39.  
  40. # Defaults for SunOS 4.1.3
  41. catch {unset ps}
  42. set ps(cmd) ps
  43. set ps(pflag) ""    ;# -p on some systems to query process
  44. set ps(aflag)  x    ;# To list all processes owned by the user
  45.  
  46. switch -glob -- [string tolower $os] {
  47.     sunos {
  48.     if [regexp ^5 [exec uname -r]] {
  49.         set ps(cmd) /bin/ps    ;# Not /usr/ucb
  50.         set ps(pflag) -p
  51.         set ps(aflag) "-u $env(USER)"
  52.     }
  53.     }
  54.     *bsd*    -
  55.     nextstep    -
  56.     nextstep-i386    -
  57.     linux {
  58.     # BSD-like systems. 
  59.     # Verified: linux
  60.     # defaults OK
  61.     }
  62.     ultrix    {
  63.     set ps(pflag) ""
  64.     set ps(aflag) "-u $env(USER)"
  65.     }
  66.     osf1    -
  67.     aix        -
  68.     dgux    -
  69.     sco_sv    -
  70.     *ptx*    -
  71.     unix    -
  72.     hp-ux    -
  73.     irix*    -
  74.     convexos    -
  75.     epix    -
  76.     uts        -
  77.     sinix-d    -
  78.     unix_system_v -
  79.     unix_sv    {
  80.     # SYS V like systems
  81.     # Verified: irix, hp-ux
  82.     set ps(pflag) -p
  83.     set ps(aflag) "-u $env(USER)"
  84.     }
  85.     default {
  86.     puts stderr "Unknown OS $os - check ps.tcl"
  87.     }
  88. }
  89.  
  90. proc PsByID { pid } {
  91.     global ps
  92.     eval exec $ps(cmd) $ps(pflag) $pid
  93. }
  94. proc PsByName { program } {
  95.     global ps
  96.     set in [open "|$ps(cmd) $ps(aflag)"]
  97.     while {[gets $in line] >= 0} {
  98.     if ![regexp {^ *([0-9]+) .*[0-9:.]+ +([^ ]+)} $line x pid name] {
  99.         continue
  100.     }
  101.     if [regexp -- $program $name] {
  102.         catch {close $in}
  103.         return $pid
  104.     }
  105.     }
  106.     catch {close $in}
  107.     return {}
  108. }
  109. proc PsTest {{self tclsh}} {
  110.     puts [exec uname -a]
  111.     puts "My process ID is [pid]"
  112.     if [catch {PsByName $self} err] {
  113.     puts "PsByName $self failed: $err"
  114.     } elseif {$err != [pid]} {
  115.     puts "PsByName($self) failed $err"
  116.     } else {
  117.     puts "PsByName OK"
  118.     }
  119.     if [catch {PsByID [pid]} err] {
  120.     puts "PsByID([pid]) failed: $err"
  121.     } else {
  122.     puts "PsByID([pid]) OK"
  123.     }
  124. }
  125.